home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / m2menu.zip / MENU2.MOD < prev    next >
Text File  |  1990-03-22  |  15KB  |  450 lines
  1.  MODULE menu2; (* Menu example, TopSpeed Modula-2 V 1.16, Ron Buelow 3/90 *)
  2.  
  3.  FROM IO     IMPORT  WrChar, WrLn, WrStr, WrStrAdj;
  4.  FROM Str    IMPORT  Length;
  5.  FROM Window IMPORT  Black, White, Clear, Close, DoubleFrame,
  6.                      GotoXY, Open, WinDef, WinType;
  7.  IMPORT MenuIO;
  8.  
  9.  CONST
  10.    DescLen  = 40;    (* max label length *)
  11.    Offset   = 1;
  12.  
  13.    NumMain  = 10;    (* total number of selections per menu *)
  14.    NumSub1  = 10;
  15.    NumSub2  = 10;
  16.    NumSub3  = 10;
  17.    NumSub4  = 10;
  18.    NumSub5  = 10;
  19.    NumSub6  = 10;
  20.    NumSub7  = 10;
  21.    NumSub8  = 10;
  22.    NumSub9  = 10;
  23.    NumSub10 = 10;
  24.  
  25.    bel  = 7C;
  26.    esc  = 33C;
  27.  
  28.  TYPE
  29.    xType = RECORD
  30.              ch: CHAR;
  31.              desc: ARRAY [0..DescLen] OF CHAR;
  32.            END;
  33.  VAR
  34.    MainMenu : ARRAY [0..NumMain-1] OF xType;
  35.    SubMenu1 : ARRAY [0..NumSub1-1] OF xType;
  36.    SubMenu2 : ARRAY [0..NumSub2-1] OF xType;
  37.    SubMenu3 : ARRAY [0..NumSub3-1] OF xType;
  38.    SubMenu4 : ARRAY [0..NumSub4-1] OF xType;
  39.    SubMenu5 : ARRAY [0..NumSub5-1] OF xType;
  40.    SubMenu6 : ARRAY [0..NumSub6-1] OF xType;
  41.    SubMenu7 : ARRAY [0..NumSub7-1] OF xType;
  42.    SubMenu8 : ARRAY [0..NumSub8-1] OF xType;
  43.    SubMenu9 : ARRAY [0..NumSub9-1] OF xType;
  44.    SubMenu10 : ARRAY [0..NumSub10-1] OF xType;
  45.  
  46.    Xch, sc : CHAR;
  47.  
  48.  (*********************************************************************)
  49.  (* Make a self-centering, self-wrapping moving bar menu              *)
  50.  (*********************************************************************)
  51.  
  52.  PROCEDURE MakeMenu(xArr: ARRAY OF xType): CHAR;
  53.  CONST
  54.    ScrDepth = 25;
  55.    ScrWidth = 80;
  56.  
  57.  VAR width, depth, left, top, right, bottom, i : CARDINAL;
  58.    j, len, maxLength: CARDINAL;
  59.    getCH, result : CHAR;
  60.    MenuWin : WinType;
  61.    WD, smWD : WinDef;
  62.    xWidth: INTEGER;
  63.  
  64.    BEGIN
  65.    maxLength := Length(xArr[0].desc);
  66.      FOR j := 1 TO HIGH(xArr) DO
  67.        len := Length(xArr[j].desc);
  68.        IF len > maxLength THEN
  69.          maxLength := len
  70.        END
  71.      END;
  72.    width := maxLength+6;
  73.    depth := HIGH(xArr)+2;
  74.    left := (ScrWidth-width) DIV 2;
  75.    right := left+width;
  76.    top := (ScrDepth-depth) DIV 3;
  77.    bottom := top+depth;
  78.    xWidth := -INTEGER(width);
  79.    WITH WD DO
  80.      X1 := left;
  81.      Y1 := top;
  82.      X2 := right;
  83.      Y2 := bottom;
  84.      Foreground := White;
  85.      Background := Black;
  86.      CursorOn := FALSE;
  87.      WrapOn := FALSE;
  88.      Hidden := FALSE;
  89.      FrameOn := TRUE;
  90.      FrameDef:= DoubleFrame;
  91.      FrameFore:= White;
  92.      FrameBack:= Black
  93.    END;(*WITH*)
  94.      MenuWin := Open(WD);
  95.      FOR i := 0 TO HIGH(xArr) DO
  96.        WITH xArr[i] DO
  97.          WrLn;
  98.          WrChar(' ');
  99.          WrChar(ch);
  100.          WrStr("  ");
  101.          WrStr(desc)
  102.        END(*WITH*)
  103.      END;(*FOR*)
  104.  
  105.    LOOP
  106.      getCH := MenuIO.GetKey(sc);
  107.      CASE getCH OF
  108.        '0'..'9' : result := xArr[ORD(sc)-2].ch; EXIT
  109.      | esc : result := esc; EXIT
  110.      ELSE
  111.        WrChar(bel) (* honk if non-valid key is hit *)
  112.      END;(*CASE*)
  113.    END;(*LOOP*)
  114.    Close(MenuWin);
  115.    RETURN result
  116.  END MakeMenu;
  117.  
  118.  
  119.  (********************************************************************)
  120.  (* Menu labels                                                      *)
  121.  (********************************************************************)
  122.  
  123.  PROCEDURE MenuLabelNumbers(VAR xArr: ARRAY OF xType);
  124.  BEGIN
  125.    xArr[0].ch := '1';
  126.    xArr[1].ch := '2';
  127.    xArr[2].ch := '3';
  128.    xArr[3].ch := '4';
  129.    xArr[4].ch := '5';
  130.    xArr[5].ch := '6';
  131.    xArr[6].ch := '7';
  132.    xArr[7].ch := '8';
  133.    xArr[8].ch := '9';
  134.    xArr[9].ch := '0'
  135.  END MenuLabelNumbers;
  136.  
  137.  PROCEDURE MainMenuLabel(VAR xArr: ARRAY OF xType);
  138.  BEGIN
  139.    MenuLabelNumbers(xArr);
  140.    xArr[0].desc := "Item One";
  141.    xArr[1].desc := "Item Two";
  142.    xArr[2].desc := "Item Three";
  143.    xArr[3].desc := "Item Four";
  144.    xArr[4].desc := "Item Five";
  145.    xArr[5].desc := "Item Six";
  146.    xArr[6].desc := "Item Seven";
  147.    xArr[7].desc := "Item Eight";
  148.    xArr[8].desc := "Item Nine";
  149.    xArr[9].desc := "Item Ten"
  150.  END MainMenuLabel;
  151.  
  152.  PROCEDURE M1(VAR xArr: ARRAY OF xType);
  153.  BEGIN
  154.    MenuLabelNumbers(xArr);
  155.    xArr[0].desc := "SubMenu One, Selection One";
  156.    xArr[1].desc := "SubMenu One, Selection Two";
  157.    xArr[2].desc := "SubMenu One, Selection Three";
  158.    xArr[3].desc := "SubMenu One, Selection Four";
  159.    xArr[4].desc := "SubMenu One, Selection Five";
  160.    xArr[5].desc := "SubMenu One, Selection Six";
  161.    xArr[6].desc := "SubMenu One, Selection Seven";
  162.    xArr[7].desc := "SubMenu One, Selection Eight";
  163.    xArr[8].desc := "SubMenu One, Selection Nine";
  164.    xArr[9].desc := "SubMenu One, Selection Ten"
  165.  END M1;
  166.  
  167.  PROCEDURE M2(VAR xArr: ARRAY OF xType);
  168.  BEGIN
  169.    MenuLabelNumbers(xArr);
  170.    xArr[0].desc := "SubMenu Two, Selection One";
  171.    xArr[1].desc := "SubMenu Two, Selection Two";
  172.    xArr[2].desc := "SubMenu Two, Selection Three";
  173.    xArr[3].desc := "SubMenu Two, Selection Four";
  174.    xArr[4].desc := "SubMenu Two, Selection Five";
  175.    xArr[5].desc := "SubMenu Two, Selection Six";
  176.    xArr[6].desc := "SubMenu Two, Selection Seven";
  177.    xArr[7].desc := "SubMenu Two, Selection Eight";
  178.    xArr[8].desc := "SubMenu Two, Selection Nine";
  179.    xArr[9].desc := "SubMenu Two, Selection Ten"
  180.  END M2;
  181.  
  182.  PROCEDURE M3(VAR xArr: ARRAY OF xType);
  183.  BEGIN
  184.    MenuLabelNumbers(xArr);
  185.    xArr[0].desc := "SubMenu Three, Selection One";
  186.    xArr[1].desc := "SubMenu Three, Selection Two";
  187.    xArr[2].desc := "SubMenu Three, Selection Three";
  188.    xArr[3].desc := "SubMenu Three, Selection Four";
  189.    xArr[4].desc := "SubMenu Three, Selection Five";
  190.    xArr[5].desc := "SubMenu Three, Selection Six";
  191.    xArr[6].desc := "SubMenu Three, Selection Seven";
  192.    xArr[7].desc := "SubMenu Three, Selection Eight";
  193.    xArr[8].desc := "SubMenu Three, Selection Nine";
  194.    xArr[9].desc := "SubMenu Three, Selection Ten"
  195.  END M3;
  196.  
  197.  PROCEDURE M4(VAR xArr: ARRAY OF xType);
  198.  BEGIN
  199.    MenuLabelNumbers(xArr);
  200.    xArr[0].desc := "SubMenu Four, Selection One";
  201.    xArr[1].desc := "SubMenu Four, Selection Two";
  202.    xArr[2].desc := "SubMenu Four, Selection Three";
  203.    xArr[3].desc := "SubMenu Four, Selection Four";
  204.    xArr[4].desc := "SubMenu Four, Selection Five";
  205.    xArr[5].desc := "SubMenu Four, Selection Six";
  206.    xArr[6].desc := "SubMenu Four, Selection Seven";
  207.    xArr[7].desc := "SubMenu Four, Selection Eight";
  208.    xArr[8].desc := "SubMenu Four, Selection Nine";
  209.    xArr[9].desc := "SubMenu Four, Selection Ten"
  210.  END M4;
  211.  
  212.  PROCEDURE M5(VAR xArr: ARRAY OF xType);
  213.  BEGIN
  214.    MenuLabelNumbers(xArr);
  215.    xArr[0].desc := "SubMenu Five, Selection One";
  216.    xArr[1].desc := "SubMenu Five, Selection Two";
  217.    xArr[2].desc := "SubMenu Five, Selection Three";
  218.    xArr[3].desc := "SubMenu Five, Selection Four";
  219.    xArr[4].desc := "SubMenu Five, Selection Five";
  220.    xArr[5].desc := "SubMenu Five, Selection Six";
  221.    xArr[6].desc := "SubMenu Five, Selection Seven";
  222.    xArr[7].desc := "SubMenu Five, Selection Eight";
  223.    xArr[8].desc := "SubMenu Five, Selection Nine";
  224.    xArr[9].desc := "SubMenu Five, Selection Ten"
  225.  END M5;
  226.  
  227.  PROCEDURE M6(VAR xArr: ARRAY OF xType);
  228.  BEGIN
  229.    MenuLabelNumbers(xArr);
  230.    xArr[0].desc := "SubMenu Six, Selection One";
  231.    xArr[1].desc := "SubMenu Six, Selection Two";
  232.    xArr[2].desc := "SubMenu Six, Selection Three";
  233.    xArr[3].desc := "SubMenu Six, Selection Four";
  234.    xArr[4].desc := "SubMenu Six, Selection Five";
  235.    xArr[5].desc := "SubMenu Six, Selection Six";
  236.    xArr[6].desc := "SubMenu Six, Selection Seven";
  237.    xArr[7].desc := "SubMenu Six, Selection Eight";
  238.    xArr[8].desc := "SubMenu Six, Selection Nine";
  239.    xArr[9].desc := "SubMenu Six, Selection Ten"
  240.  END M6;
  241.  
  242.  PROCEDURE M7(VAR xArr: ARRAY OF xType);
  243.  BEGIN
  244.    MenuLabelNumbers(xArr);
  245.    xArr[0].desc := "SubMenu Seven, Selection One";
  246.    xArr[1].desc := "SubMenu Seven, Selection Two";
  247.    xArr[2].desc := "SubMenu Seven, Selection Three";
  248.    xArr[3].desc := "SubMenu Seven, Selection Four";
  249.    xArr[4].desc := "SubMenu Seven, Selection Five";
  250.    xArr[5].desc := "SubMenu Seven, Selection Six";
  251.    xArr[6].desc := "SubMenu Seven, Selection Seven";
  252.    xArr[7].desc := "SubMenu Seven, Selection Eight";
  253.    xArr[8].desc := "SubMenu Seven, Selection Nine";
  254.    xArr[9].desc := "SubMenu Seven, Selection Ten"
  255.  END M7;
  256.  
  257.  PROCEDURE M8(VAR xArr: ARRAY OF xType);
  258.  BEGIN
  259.    MenuLabelNumbers(xArr);
  260.    xArr[0].desc := "SubMenu Eight, Selection One";
  261.    xArr[1].desc := "SubMenu Eight, Selection Two";
  262.    xArr[2].desc := "SubMenu Eight, Selection Three";
  263.    xArr[3].desc := "SubMenu Eight, Selection Four";
  264.    xArr[4].desc := "SubMenu Eight, Selection Five";
  265.    xArr[5].desc := "SubMenu Eight, Selection Six";
  266.    xArr[6].desc := "SubMenu Eight, Selection Seven";
  267.    xArr[7].desc := "SubMenu Eight, Selection Eight";
  268.    xArr[8].desc := "SubMenu Eight, Selection Nine";
  269.    xArr[9].desc := "SubMenu Eight, Selection Ten"
  270.  END M8;
  271.  
  272.  PROCEDURE M9(VAR xArr: ARRAY OF xType);
  273.  BEGIN
  274.    MenuLabelNumbers(xArr);
  275.    xArr[0].desc := "SubMenu Nine, Selection One";
  276.    xArr[1].desc := "SubMenu Nine, Selection Two";
  277.    xArr[2].desc := "SubMenu Nine, Selection Three";
  278.    xArr[3].desc := "SubMenu Nine, Selection Four";
  279.    xArr[4].desc := "SubMenu Nine, Selection Five";
  280.    xArr[5].desc := "SubMenu Nine, Selection Six";
  281.    xArr[6].desc := "SubMenu Nine, Selection Seven";
  282.    xArr[7].desc := "SubMenu Nine, Selection Eight";
  283.    xArr[8].desc := "SubMenu Nine, Selection Nine";
  284.    xArr[9].desc := "SubMenu Nine, Selection Ten"
  285.  END M9;
  286.  
  287.  PROCEDURE M10(VAR xArr: ARRAY OF xType);
  288.  BEGIN
  289.    MenuLabelNumbers(xArr);
  290.    xArr[0].desc := "SubMenu Ten, Selection One";
  291.    xArr[1].desc := "SubMenu Ten, Selection Two";
  292.    xArr[2].desc := "SubMenu Ten, Selection Three";
  293.    xArr[3].desc := "SubMenu Ten, Selection Four";
  294.    xArr[4].desc := "SubMenu Ten, Selection Five";
  295.    xArr[5].desc := "SubMenu Ten, Selection Six";
  296.    xArr[6].desc := "SubMenu Ten, Selection Seven";
  297.    xArr[7].desc := "SubMenu Ten, Selection Eight";
  298.    xArr[8].desc := "SubMenu Ten, Selection Nine";
  299.    xArr[9].desc := "SubMenu Ten, Selection Ten"
  300.  END M10;
  301.  
  302.  (********************************************************************)
  303.  (* Execute menu selections                                          *)
  304.  (********************************************************************)
  305.  
  306.  PROCEDURE MenuAction(VAR xArr: ARRAY OF xType);
  307.  BEGIN
  308.     CASE Xch OF
  309.       '1': Xch := MakeMenu(SubMenu1);
  310.            CASE Xch OF
  311.              '0'..'9' : Clear;
  312.                         WrStr("SubMenu 1");
  313.                         WrStr(", Selection ");
  314.                         WrChar(Xch);
  315.                         WrStr(": Executed!");
  316.                         WrLn;
  317.                         WrLn;
  318.                         MenuIO.ExecCmd('pause')
  319.           END;(*CASE*)
  320.     | '2': Xch := MakeMenu(SubMenu2);
  321.            CASE Xch OF
  322.              '0'..'9' : Clear;
  323.                         WrStr("SubMenu 2");
  324.                         WrStr(", Selection ");
  325.                         WrChar(Xch);
  326.                         WrStr(": Executed!");
  327.                         WrLn;
  328.                         WrLn;
  329.                         MenuIO.ExecCmd('pause')
  330.           END;(*CASE*)
  331.     | '3': Xch := MakeMenu(SubMenu3);
  332.            CASE Xch OF
  333.              '0'..'9' : Clear;
  334.                         WrStr("SubMenu 3");
  335.                         WrStr(", Selection ");
  336.                         WrChar(Xch);
  337.                         WrStr(": Executed!");
  338.                         WrLn;
  339.                         WrLn;
  340.                         MenuIO.ExecCmd('pause')
  341.           END;(*CASE*)
  342.     | '4': Xch := MakeMenu(SubMenu4);
  343.            CASE Xch OF
  344.              '0'..'9' : Clear;
  345.                         WrStr("SubMenu 4");
  346.                         WrStr(", Selection ");
  347.                         WrChar(Xch);
  348.                         WrStr(": Executed!");
  349.                         WrLn;
  350.                         WrLn;
  351.                         MenuIO.ExecCmd('pause')
  352.           END;(*CASE*)
  353.     | '5': Xch := MakeMenu(SubMenu5);
  354.            CASE Xch OF
  355.              '0'..'9' : Clear;
  356.                         WrStr("SubMenu 5");
  357.                         WrStr(", Selection ");
  358.                         WrChar(Xch);
  359.                         WrStr(": Executed!");
  360.                         WrLn;
  361.                         WrLn;
  362.                         MenuIO.ExecCmd('pause')
  363.           END;(*CASE*)
  364.     | '6': Xch := MakeMenu(SubMenu6);
  365.            CASE Xch OF
  366.              '0'..'9' : Clear;
  367.                         WrStr("SubMenu 6");
  368.                         WrStr(", Selection ");
  369.                         WrChar(Xch);
  370.                         WrStr(": Executed!");
  371.                         WrLn;
  372.                         WrLn;
  373.                         MenuIO.ExecCmd('pause')
  374.           END;(*CASE*)
  375.     | '7': Xch := MakeMenu(SubMenu7);
  376.            CASE Xch OF
  377.              '0'..'9' : Clear;
  378.                         WrStr("SubMenu 7");
  379.                         WrStr(", Selection ");
  380.                         WrChar(Xch);
  381.                         WrStr(": Executed!");
  382.                         WrLn;
  383.                         WrLn;
  384.                         MenuIO.ExecCmd('pause')
  385.           END;(*CASE*)
  386.     | '8': Xch := MakeMenu(SubMenu8);
  387.            CASE Xch OF
  388.              '0'..'9' : Clear;
  389.                         WrStr("SubMenu 8");
  390.                         WrStr(", Selection ");
  391.                         WrChar(Xch);
  392.                         WrStr(": Executed!");
  393.                         WrLn;
  394.                         WrLn;
  395.                         MenuIO.ExecCmd('pause')
  396.           END;(*CASE*)
  397.     | '9': Xch := MakeMenu(SubMenu9);
  398.            CASE Xch OF
  399.              '0'..'9' : Clear;
  400.                         WrStr("SubMenu 9");
  401.                         WrStr(", Selection ");
  402.                         WrChar(Xch);
  403.                         WrStr(": Executed!");
  404.                         WrLn;
  405.                         WrLn;
  406.                         MenuIO.ExecCmd('pause')
  407.           END;(*CASE*)
  408.     | '0': Xch := MakeMenu(SubMenu10);
  409.            CASE Xch OF
  410.              '0'..'9' : Clear;
  411.                         WrStr("SubMenu 10");
  412.                         WrStr(", Selection ");
  413.                         WrChar(Xch);
  414.                         WrStr(": Executed!");
  415.                         WrLn;
  416.                         WrLn;
  417.                         MenuIO.ExecCmd('pause')
  418.           END;(*CASE*)
  419.    END(*CASE*)
  420.  END MenuAction;
  421.  
  422.  (* Run program *)
  423.  
  424.  BEGIN
  425.    MainMenuLabel(MainMenu); (* initialize menus *)
  426.    M1(SubMenu1);
  427.    M2(SubMenu2);
  428.    M3(SubMenu3);
  429.    M4(SubMenu4);
  430.    M5(SubMenu5);
  431.    M6(SubMenu6);
  432.    M7(SubMenu7);
  433.    M8(SubMenu8);
  434.    M9(SubMenu9);
  435.    M10(SubMenu10);
  436.  
  437.    LOOP
  438.      Clear;
  439.  
  440.      GotoXY(30,3);
  441.        WrStr("<Esc> key exits program");
  442.      GotoXY(11,18);
  443.        WrStr("Press the number (top row number key) of desired selection > ");
  444.  
  445.      Xch := MakeMenu(MainMenu);
  446.      IF Xch = esc THEN EXIT END;(*IF*)
  447.      MenuAction(MainMenu); (* execute selection *)
  448.    END;(*LOOP*)
  449.    Clear
  450.  END menu2.